Potrebno je pre svega razdvojiti uzorak na validacioni i estimacioni. U nacelu pravilo je da se uzorak deli na 70:30 na stranu estimacije,i u slucaju malih preduzeca to cemo i koristiti. Pa, pocnimo.
#izracunam broj redova
broj.red.small<-nrow(small)
broj.difolta.small<-sum(as.numeric(small$default.y==1))
procenat.difolta<-broj.difolta.small/broj.red.small
set.seed(45)
#zbog reprodukcije
sample.small <-
sample(broj.red.small, size = round(0.75 * broj.red.small, 0))
small.training <- small[sample.small, ]
small.test <- small[-sample.small, ]
Jos jednom cemo pregledati varijable:
#rpivotTable(lrge.training)
summary_table.small<-t(sapply(small.training[,11:43],my.summary,arg=T))
tr_summary_table.small<-t(summary_table.small)
formatRound(
datatable(
summary_table.small,caption = "Tabela 3.:Sumarni prikaz",
filter = 'none'
),
columns = colnames(summary_table.small)
)
Generalna preporuka je da se radna hipoteza testira pre tretmana nedostajućih vrednosti budući da će se nedostajuće vrednosti popunjavati uslovno od stanja solventnosti duznika. Samim tim ovde cemo kao prvi vid selekcije ispitati radnu hipotezu kako kontinualnih tako i kategorickih varijabli. Počećemo sa kontinualnim1 i analizu raditi u paru sa proverom diskriminativnosti varijabli. Još u Tabeli 3 vidimo velika odstupanja srednje vrednosti od medijane i trimovanog proseka, buduci da je prosek kao mera centralne tendencije osetljiva na autlajere odlucujemo se da posmatramo medijanu i trimovan prosek, samim tim mogucnost t testa otpada. Dalje, sledeci preporuke iz literature ovaj deo analize osloniti na posmatranje box plotova i bice dopunjen diskriminativnom analizom AUROC-a. Pri testiranju korelacija prag selekcije postavljamo na 0.5 i od dve biramo onu varijablu koja ima vecu diskriminacionu moc.
Kod kategorickih varijabli posmatracemo tabele frekvencija tamo gde to bude imalo smisla i sprovesti Chi-squared test. Ovom prilikom potrebno je i pregrupisati ove varijable tako da budu zadovoljeni kriterijumi:
Prvo pregledajmo samu distribuciju jos jednom, mada su neke stvari vec jasne iz Tabele 3 hajde ipak da pogledamo.
Prvo kreiramo funkciju za plotiranje: qq plota, box plota, poredjenja gustina verovatnoce (kernela empiriskih distribucija verovatnoce) i konacno za proveru diskriminacije ROC krive.
#delimo uzorak na kontinualne i kategoricke
small.training.continualne<-small.training[,c(7,6,11,13:43)]
small.training.kategoricke<-small.training[,c(7,8,9,10,12)]
small.test.continualne<-small.test[,c(7,6,11,13:43)]
small.test.kategoricke<-small.test[,c(7,8,9,10,12)]
#definisem funkciju za plotovanje
ploting(small.training,6,7)
Ignoring unknown parameters: positionRemoved 1796 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,11,7)
Ignoring unknown parameters: positionRemoved 2621 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,13,7)
Ignoring unknown parameters: positionRemoved 3268 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,14,7)
Ignoring unknown parameters: positionRemoved 3208 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,15,7)
Ignoring unknown parameters: positionRemoved 3552 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,16,7)
Ignoring unknown parameters: positionRemoved 1723 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,17,7)
Ignoring unknown parameters: positionRemoved 3558 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,18,7)
Ignoring unknown parameters: positionRemoved 3590 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,19,7)
Ignoring unknown parameters: positionRemoved 3058 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,20,7)
Ignoring unknown parameters: positionRemoved 3104 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,21,7)
Ignoring unknown parameters: positionRemoved 3336 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,22,7)
Ignoring unknown parameters: positionRemoved 3398 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,23,7)
Ignoring unknown parameters: positionRemoved 3470 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,24,7)
Ignoring unknown parameters: positionRemoved 3536 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,25,7)
Ignoring unknown parameters: positionRemoved 3454 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,26,7)
Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,27,7)
Ignoring unknown parameters: positionRemoved 3092 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(lrge.training,28,7)
Ignoring unknown parameters: positionRemoved 120 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,29,7)
Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,30,7)
Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,31,7)
Ignoring unknown parameters: positionRemoved 3054 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,32,7)
Ignoring unknown parameters: positionRemoved 2966 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(lrge.training,33,7,n=1)
Ignoring unknown parameters: positionRemoved 126 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,34,7)
Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,35,7)
Ignoring unknown parameters: positionRemoved 1796 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,36,7)
Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,37,7)
Ignoring unknown parameters: positionRemoved 3394 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,38,7)
Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,39,7)
Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,40,7)
Ignoring unknown parameters: positionRemoved 3394 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,41,7)
Ignoring unknown parameters: positionRemoved 3394 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,42,7)
Ignoring unknown parameters: positionRemoved 3394 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
#definisem funkciju za plotovanje
ploting(small.training,43,7)
Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!
U tabeli 5. ispod vidimo da najvecu diskriminacionu moc poseduje varijabla T14 odmah iza koje je ALtman 1.
#proracun
cor=cor(small.training.continualne[,c(-1,-31,-32,-33)], use = "complete.obs")
#dodajemo AUROC kao dodatnu kolonu pored varijable
corr_summary.small <- function (predictor) {
response = factor(small.training.continualne[[1]])
suppressMessages(auc(response, as.numeric(predictor)))
}
auc_sumarno.small<-sapply(small.training.continualne[,c(-1,-31,-32,-33)], corr_summary.small)
kor_diskr.small<-(cbind(auc_sumarno.small,cor))
formatRound(
datatable(
kor_diskr.small,caption = "Tabela 5.:Sumarni prikaz",
filter = 'none'
),
columns = colnames(kor_diskr.small)
)
as.data.frame(kor_diskr.small)
Ovde kreiram funkciju koja ce da filtrira varijable po kriterijumu korelacije. Naime, po ugledu na 2 kao kriterijum granice koeficijenta korelacije preko koje ne bismo smeli prelaziti uzecemo vrednost od 0.5 koji ce u sprezi sa AUROC vrednosti selektirati jednu od dve varijable. Konacan izbor varijabli se vidi u korelacionoj tabeli ispod.
#assuming that table is n x (n+1) matrix where first column is AUROC value and the rest n x n is correlation matrix
clean_cor.small<-corr_ellimination(kor_diskr.small)
knitr::kable(clean_cor.small, caption = "Tabela 6. skracena korelaciona tabela koja sadrzi varijable nad kojima ce se vrsiti dalja analiza")
| AUROC | Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja | T14 | T12 | Racio_novcane_likvidnosti_(Cash_ratio) | Asset_turnover | Racio_pokrica_obrtne_imovine | Stepen_zaduzenosti | udeo_u_kapitalu | Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio) | Vreme_placanja_dobavljacima | Vreme_naplate_potrazivanja | Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja | Pokrice_neto_kamata | Rast_EBITDA | Racio_obrta_potrazivanja_od_kupaca | Vreme_kreditiranja_kupaca | Gotovinski_ciklus_1 | Broj_zaposlenih | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja | 0.7147068 | 1.0000000 | 0.1165590 | 0.4341258 | 0.1128484 | 0.1958647 | 0.0502256 | -0.0263482 | -0.0463149 | 0.0525652 | -0.0062347 | -0.0199984 | 0.0839210 | -0.0157552 | 0.0348603 | 0.0172483 | -0.0206373 | 0.0159378 | 0.0024429 |
| T14 | 0.6973945 | 0.1165590 | 1.0000000 | 0.2611100 | 0.4795674 | -0.0360332 | 0.0291147 | -0.0122102 | -0.0179755 | 0.0709050 | -0.0010359 | 0.0198123 | 0.0028667 | 0.0012714 | -0.0017285 | 0.0048825 | -0.0020000 | 0.0166443 | 0.0058777 |
| T12 | 0.6826563 | 0.4341258 | 0.2611100 | 1.0000000 | 0.1604509 | 0.0327279 | 0.0874663 | -0.0455573 | -0.0625975 | 0.0418614 | -0.0109842 | -0.0128638 | 0.0135095 | -0.0002496 | 0.0004469 | 0.0132799 | -0.0075940 | 0.0450543 | -0.0570053 |
| Racio_novcane_likvidnosti_(Cash_ratio) | 0.6626892 | 0.1128484 | 0.4795674 | 0.1604509 | 1.0000000 | 0.0040580 | 0.0166795 | -0.0052041 | 0.0028099 | 0.0210549 | -0.0010279 | -0.0036502 | 0.0032425 | 0.0085779 | 0.0031441 | 0.0291830 | -0.0035404 | 0.0066690 | -0.0071846 |
| Asset_turnover | 0.6606203 | 0.1958647 | -0.0360332 | 0.0327279 | 0.0040580 | 1.0000000 | 0.0542484 | -0.0028212 | -0.0600007 | -0.0064448 | -0.0085182 | -0.0413325 | 0.0194380 | 0.0055620 | -0.0029900 | 0.0304797 | -0.0424542 | 0.0057830 | -0.0077756 |
| Racio_pokrica_obrtne_imovine | 0.6564486 | 0.0502256 | 0.0291147 | 0.0874663 | 0.0166795 | 0.0542484 | 1.0000000 | -0.0156468 | -0.0197482 | 0.0033306 | -0.0728406 | -0.0241162 | 0.0114168 | -0.0008814 | -0.0000493 | -0.0010631 | -0.0111443 | 0.0418198 | 0.0064618 |
| Stepen_zaduzenosti | 0.6424143 | -0.0263482 | -0.0122102 | -0.0455573 | -0.0052041 | -0.0028212 | -0.0156468 | 1.0000000 | 0.0061415 | -0.0021876 | 0.0002599 | 0.0035013 | -0.4251569 | 0.0008968 | 0.0104463 | -0.0011129 | 0.0021755 | -0.0045131 | -0.0089361 |
| udeo_u_kapitalu | 0.6266576 | -0.0463149 | -0.0179755 | -0.0625975 | 0.0028099 | -0.0600007 | -0.0197482 | 0.0061415 | 1.0000000 | 0.0053304 | -0.0000342 | 0.0183950 | -0.0031334 | -0.0108029 | 0.0044632 | 0.0010618 | 0.0185163 | -0.0005606 | 0.0252817 |
| Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio) | 0.6165062 | 0.0525652 | 0.0709050 | 0.0418614 | 0.0210549 | -0.0064448 | 0.0033306 | -0.0021876 | 0.0053304 | 1.0000000 | -0.0000778 | 0.0047461 | 0.0039572 | 0.0361806 | 0.0030683 | -0.0008095 | 0.0252395 | 0.0055216 | 0.0063174 |
| Vreme_placanja_dobavljacima | 0.6159324 | -0.0062347 | -0.0010359 | -0.0109842 | -0.0010279 | -0.0085182 | -0.0728406 | 0.0002599 | -0.0000342 | -0.0000778 | 1.0000000 | 0.0081789 | -0.0001728 | -0.0002227 | 0.0000988 | -0.0004297 | 0.0042198 | -0.0542947 | -0.0050480 |
| Vreme_naplate_potrazivanja | 0.6154063 | -0.0199984 | 0.0198123 | -0.0128638 | -0.0036502 | -0.0413325 | -0.0241162 | 0.0035013 | 0.0183950 | 0.0047461 | 0.0081789 | 1.0000000 | -0.0026687 | -0.0001631 | -0.0005822 | -0.0025271 | 0.3153157 | -0.0838092 | -0.0141436 |
| Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja | 0.6001106 | 0.0839210 | 0.0028667 | 0.0135095 | 0.0032425 | 0.0194380 | 0.0114168 | -0.4251569 | -0.0031334 | 0.0039572 | -0.0001728 | -0.0026687 | 1.0000000 | -0.0021279 | 0.0022940 | 0.0008047 | -0.0019686 | 0.0041697 | -0.0028191 |
| Pokrice_neto_kamata | 0.5986841 | -0.0157552 | 0.0012714 | -0.0002496 | 0.0085779 | 0.0055620 | -0.0008814 | 0.0008968 | -0.0108029 | 0.0361806 | -0.0002227 | -0.0001631 | -0.0021279 | 1.0000000 | -0.0002522 | 0.0015299 | 0.0013857 | 0.0006617 | 0.0020257 |
| Rast_EBITDA | 0.5949098 | 0.0348603 | -0.0017285 | 0.0004469 | 0.0031441 | -0.0029900 | -0.0000493 | 0.0104463 | 0.0044632 | 0.0030683 | 0.0000988 | -0.0005822 | 0.0022940 | -0.0002522 | 1.0000000 | 0.0001519 | -0.0007876 | 0.0021314 | -0.0033808 |
| Racio_obrta_potrazivanja_od_kupaca | 0.5944460 | 0.0172483 | 0.0048825 | 0.0132799 | 0.0291830 | 0.0304797 | -0.0010631 | -0.0011129 | 0.0010618 | -0.0008095 | -0.0004297 | -0.0025271 | 0.0008047 | 0.0015299 | 0.0001519 | 1.0000000 | -0.0029311 | 0.0032876 | 0.0035148 |
| Vreme_kreditiranja_kupaca | 0.5870546 | -0.0206373 | -0.0020000 | -0.0075940 | -0.0035404 | -0.0424542 | -0.0111443 | 0.0021755 | 0.0185163 | 0.0252395 | 0.0042198 | 0.3153157 | -0.0019686 | 0.0013857 | -0.0007876 | -0.0029311 | 1.0000000 | -0.0060538 | -0.0158706 |
| Gotovinski_ciklus_1 | 0.5806210 | 0.0159378 | 0.0166443 | 0.0450543 | 0.0066690 | 0.0057830 | 0.0418198 | -0.0045131 | -0.0005606 | 0.0055216 | -0.0542947 | -0.0838092 | 0.0041697 | 0.0006617 | 0.0021314 | 0.0032876 | -0.0060538 | 1.0000000 | -0.0101120 |
| Broj_zaposlenih | 0.5734997 | 0.0024429 | 0.0058777 | -0.0570053 | -0.0071846 | -0.0077756 | 0.0064618 | -0.0089361 | 0.0252817 | 0.0063174 | -0.0050480 | -0.0141436 | -0.0028191 | 0.0020257 | -0.0033808 | 0.0035148 | -0.0158706 | -0.0101120 | 1.0000000 |
Ovako, generalno, ono sto nismo (nismo hteli komentarisati) komentarisali su simetricnosti varijabli. Pozitivno asimetricno je bar pola posmatranih varijabli tako da bi valjala neka vrsta logaritmovane transformacije uz vodjenje racuna o negativnim vrednostima (na primer transformacija tipa: \(\log(var + \min(var) + 1))\) bi se pobrinula za negativne vrednosti. Box Za negativnu asimetricnost bi koristili eventualno eksponencijalnu transformaciju. Videcemo posle prvog stepwisea i AUROC-a.
Ipak, ovde cemo se koncentrisati na par prethodno napomenutih varijabli.
Prvo cemo podeliti varijablu na n intervala. Za optimalan broj intervala mozemo iskoristiti drugu funkciju koja ima algoritam koji bira broj intervala od 10 do 20 na osnovu odredjenih kriterijuma, vidi help funkcije dole.
#kreiram tabelu od pokrica neto kamata i indikatora default-a
data<-small.training[,c("default.y","Pokrice_neto_kamata")]
IV <- create_infotables(data=data,
y="default.y",
parallel=FALSE)
IV_Value = data.frame(IV$Summary)
IV_Value
IV$Tables
$Pokrice_neto_kamata
plot_infotables(IV,"Pokrice_neto_kamata")
Dakle optimum je 10, imajuci u obzir nedostajuce vrednosti kao 11 kategoriju. Sada racunamo fiting funkciju transformacije. Generalno, mogli bismo podeliti varijablu u 8 kategorickih, ali ja bih izbegao to. Hajde prvo da vidimo empirijsku distribuciju, pa da fitujemo.
#izracunam medijanu po svakom binu
Postoje tri kategoricke varijable koje je potrebno analizirati:
rpivotTable(lrge.training.kategoricke,
rows = "default.y",
cols = "Strani_investitor",
aggregatorName = "Count as Fraction of Columns")
freq_table=function(dta,kategorical,default){
kategorical=as.name(kategorical)
default=as.name(default)
tmp=dta[,.N,by=.(eval(kategorical),eval(default))]
frekvenca_sektor<-dcast(tmp,eval(kategorical)~eval(default),value.var="N")
frekvenca_sektor$`0`[is.na(frekvenca_sektor$`0`)]=0
frekvenca_sektor$`1`[is.na(frekvenca_sektor$`1`)]=0
ukupno<-frekvenca_sektor$`0`+frekvenca_sektor$`1`
frekvenca_sektor<-cbind.data.frame(frekvenca_sektor,ukupno)
frekvenca_sektor[,default_rate:=frekvenca_sektor$`1`/ukupno]
as.data.frame(frekvenca_sektor)
}
freq_table(small.training.kategoricke,"Sifra_sektor","default.y")
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="B"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="G"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="J"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="P"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="Q"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="R"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="B"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="G"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="J"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="P"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="Q"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="R"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="M"]<-"6%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="N"]<-"6%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="S"]<-"6%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="F"]<-"6%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="M"]<-"6%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="N"]<-"6%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="S"]<-"6%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="F"]<-"6%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="H"]<-"3%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="E"]<-"3%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="H"]<-"3%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="E"]<-"3%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="I"]<-"10%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="J"]<-"9%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="K"]<-"9%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="I"]<-"10%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="J"]<-"9%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="K"]<-"9%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="A"]<-"5%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="C"]<-"5%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="D"]<-"5%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="A"]<-"5%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="C"]<-"5%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="D"]<-"5%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="L"]<-"14%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="L"]<-"14%"
freq_table(small.training.kategoricke,"Sifra_sektor1","default.y")
data_sifra_sektor.small<-small.training.kategoricke[,c("default.y","Sifra_sektor1")]
IV_sifra_sektor.small<-create_infotables(data=data_sifra_sektor.small,
y="default.y",
parallel=FALSE)
IV_sifra_sektor.small$Tables
$Sifra_sektor1
NA
Information value je bzveze, probajmo sada jos da pregrupišemo:
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="10%"]<-"10%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="14%"]<-"14%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="9%"]<-"6-9%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="6%"]<-"6-9%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="10%"]<-"10%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="14%"]<-"14%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="9%"]<-"6-9%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="6%"]<-"6-9%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="5%"]<-"5%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="4%"]<-"5%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="3%"]<-"3%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="5%"]<-"5%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="4%"]<-"5%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="3%"]<-"3%"
data_sifra_sektor.small<-small.training.kategoricke[,c("default.y","Sifra_sektor2")]
IV_sifra_sektor.small<-create_infotables(data=data_sifra_sektor.small,
y="default.y",
parallel=FALSE)
IV_sifra_sektor.small$Tables
$Sifra_sektor2
NA
Zakljucujemo da, sektor kod malih i mikro preduzeca ne igra bas bitnu ulogu ali cemo uzeti ovu varijablu. ####Sifra opstine:
freq_table(small.training.kategoricke,"Sifra_opstine","default.y")
Za pocetak cemo smestiti sve opstine koje imaju manje od 100 duznika i manje od 5 difoltera u jednu klasu.
temp.table<-freq_table(small.training.kategoricke,"Sifra_opstine","default.y")
ostalo.small.names<-temp.table[temp.table$ukupno<100,1]
small.training.kategoricke$Sifra_opstine1<-small.training.kategoricke$Sifra_opstine
small.training.kategoricke$Sifra_opstine1[small.training.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
small.test.kategoricke$Sifra_opstine1<-small.test.kategoricke$Sifra_opstine
small.test.kategoricke$Sifra_opstine1[small.test.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
ostalo.small.names<-temp.table[temp.table$`1`<5,1]
small.training.kategoricke$Sifra_opstine1[small.training.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
small.training.kategoricke$Sifra_opstine1[small.training.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
small.test.kategoricke$Sifra_opstine1[small.test.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
small.test.kategoricke$Sifra_opstine1[small.test.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
temp.table<-freq_table(small.training.kategoricke,"Sifra_opstine1","default.y")
temp.table
Svstavamo ih po stopi difolta da vidimo da li se sta moze promeniti
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
c(70041, 70955, 80403)] <- "2%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
c(70041, 70955, 80403)] <- "2%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
c(70653,71099,71242,79065,80128)] <- "3%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
c(70653,71099,71242,79065,80128)] <- "3%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in% c(70033,70483,70904,71048,71269,79022,79057,80110,80438,80462,"ostalo")] <- "4%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in% c(70033,70483,70904,71048,71269,79022,79057,80110,80438,80462,"ostalo")] <- "4%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
c(89010,80466,80420,80357,80314,80195,80179,80152,80071,70670,70459,70360,70645)] <- "5%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
c(89010,80466,80420,80357,80314,80195,80179,80152,80071,70670,70459,70360,70645)] <- "5%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
c(70726,70734,71102,71200,79014,79049,80063,80446)] <- "6%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
c(70726,70734,71102,71200,79014,79049,80063,80446)] <- "6%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
c(70874,70564,70386,80381)] <- "7%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
c(70874,70564,70386,80381)] <- "7%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
c(80209,80233)] <- "8>%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
c(80209,80233)] <- "8>%"
data_sifra_ostine.small<-small.training.kategoricke[,c("default.y","Sifra_opstine2")]
IV_sifra_sektor<-create_infotables(data=data_sifra_ostine.small,
y="default.y",
parallel=FALSE)
IV_sifra_sektor$Tables
$Sifra_opstine2
NA
probajmo da pregrupisemo
small.training.kategoricke$Sifra_opstine3<-small.training.kategoricke$Sifra_opstine2
small.training.kategoricke$Sifra_opstine3[small.training.kategoricke$Sifra_opstine2 %in%
c("4%","5%")] <- "4-5%"
small.test.kategoricke$Sifra_opstine3<-small.test.kategoricke$Sifra_opstine2
small.test.kategoricke$Sifra_opstine3[small.test.kategoricke$Sifra_opstine2 %in%
c("4%","5%")] <- "4-5%"
#small.training.kategoricke$Sifra_opstine3[(small.training.kategoricke$Sifra_opstine2 %in%
#c("5%","6%","7%","8>%"))] <- "high%"
data_sifra_ostine.small2<-small.training.kategoricke[,c("default.y","Sifra_opstine3")]
IV_sifra_sektor2<-create_infotables(data=data_sifra_ostine.small2,
y="default.y",
parallel=FALSE)
IV_sifra_sektor2$Tables
$Sifra_opstine3
freq_table(small.training.kategoricke,"Sifra_opstine3","default.y")
cak i ovako rasporedjene imaju slabu prediktivnu moc. pokusavamo sada po razvijenosti opstina, ovo necemo uzimati jer nema nekog logicnog objasnjenja a diskriminativnost i nije velika
IV_razvijenost2$Tables
$Razvijenost
NA
beznacajno, konacan zakljucak je da idemo sa varijablom Sifra_opstine3 ####Strani investitor
Pogledajmo prvo frekvencionu tabelu
freq_table(small.training.kategoricke,"Strani_investitor","default.y")
Postoji razlika, imajuci u vidu da ovde imamo samo dve varijable, to je i ocekivano, hajde da vidimo IV:
WOETable(X=as.factor(small.training.kategoricke$Strani_investitor),Y=(small.training.kategoricke$default.y-1)*(-1))
nema uticaja
WOETable(X=as.factor(small.training.kategoricke$Velicina),Y=(small.training.kategoricke$default.y-1)*(-1))
marginalno
Dosadasnji rezultati:
Otpadanje usled NA vrednosti, prezivele su sledece varijable:
preziveli.NA.small
[1] "Broj_zaposlenih"
[2] "Velicina"
[3] "Rigorozni_racio_redukovane_(monetarne)_likvidnosti"
[4] "Opsti_racio_likvidnosti"
[5] "Stepen_zaduzenosti"
[6] "Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)"
[7] "Racio_pokrica_obrtne_imovine"
[8] "Gotovinski_ciklus_1"
[9] "Vreme_vezivanja_zaliha"
[10] "Vreme_kreditiranja_kupaca"
[11] "Vreme_naplate_potrazivanja"
[12] "Vreme_placanja_dobavljacima"
[13] "Asset_turnover"
[14] "Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja"
[15] "Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja"
[16] "Basic_Earnings_Power_Ratio"
[17] "Cena_tudjih_izvora_sredstava"
[18] "T11"
[19] "T12"
[20] "T13"
[21] "T14"
[22] "T15"
[23] "T21"
[24] "Altman I"
[25] "Altman emerging markets"
[26] "Altman private firms"
[27] "udeo_u_kapitalu"
Ciscenje usled korelacija i AUROC-a manjeg od 0.55
preziveli.corr.AUC.small
[1] "Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja"
[2] "T14"
[3] "T12"
[4] "Racio_novcane_likvidnosti_(Cash_ratio)"
[5] "Asset_turnover"
[6] "Racio_pokrica_obrtne_imovine"
[7] "Stepen_zaduzenosti"
[8] "udeo_u_kapitalu"
[9] "Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)"
[10] "Vreme_placanja_dobavljacima"
[11] "Vreme_naplate_potrazivanja"
[12] "Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja"
[13] "Pokrice_neto_kamata"
[14] "Rast_EBITDA"
[15] "Racio_obrta_potrazivanja_od_kupaca"
[16] "Vreme_kreditiranja_kupaca"
[17] "Gotovinski_ciklus_1"
[18] "Broj_zaposlenih"
Presek ova dva nastavlja u multivariate.
odabrani.small
[1] "Racio_novcane_likvidnosti_(Cash_ratio)"
[2] "Broj_zaposlenih"
[3] "Stepen_zaduzenosti"
[4] "Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)"
[5] "Racio_pokrica_obrtne_imovine"
[6] "Gotovinski_ciklus_1"
[7] "Vreme_kreditiranja_kupaca"
[8] "Vreme_naplate_potrazivanja"
[9] "Vreme_placanja_dobavljacima"
[10] "Asset_turnover"
[11] "Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja"
[12] "Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja"
[13] "T12"
[14] "T14"
[15] "udeo_u_kapitalu"
Tretman nedostajucih i tretman autlajera, potom dodajemo kategoricke
finalni_small<-small.training[,c(odabrani.small),with=F]
finalni_small.test<-small.test[,c(odabrani.small),with=F]
#finalni_lrge<-cbind.data.frame(finalni_lrge,Asset_turnover$Asset_turnover.tr,Pokrice_neto_kamata$Pokrice_neto_kamata.tr)
finalni_small<-as.data.table(sapply(finalni_small,replace_outlier_with_quantile))
finalni_small.test<-as.data.table(sapply(finalni_small.test,replace_outlier_with_quantile))
finalni_small$default.y<-small.training$default.y
finalni_small<-replace_missing_with_knn(finalni_small)
finalni_small$default.y<-NULL
opciono, transformacija
AA<-data.frame(1:nrow(finalni_small));n=1
for(i in names(finalni_small)["default.y" != names(finalni_small)]) {
n = n + 1
tmp <- calibrate_parameters(finalni_small, i, "default.y")
AA <- cbind.data.frame(AA, tmp[[7]])
names(AA)[n] <- names(finalni_small)[n]
}
finalni_small <- AA
remove(AA)
finalni_small[, 1] <- NULL
finalni_small$default.y <- default.y
finalni_small <- as.data.table(finalni_small)
Dodajemo dve kategoricke:
#spajamo sa kategorickim i skidamo par viskova kategorickih, velicina, total
finalni_small <-
cbind.data.frame(finalni_small, small.training.kategoricke[, c("Velicina","Sifra_sektor2","Sifra_opstine3")])
finalni_small.test <-
cbind.data.frame(finalni_small.test, small.test.kategoricke[, c("Velicina","Sifra_sektor2","Sifra_opstine3")])
#pretvaram kategoricke u faktor da bi ih glm posmatrao kao kategoricke
finalni_small$Sifra_sektor2 <- as.factor(finalni_small$Sifra_sektor2)
finalni_small$Velicina <-as.factor(finalni_small$Velicina)
finalni_small$Sifra_opstine3 <-as.factor(finalni_small$Sifra_opstine3)
finalni_small.test$Sifra_sektor2 <- as.factor(finalni_small.test$Sifra_sektor2)
finalni_small.test$Velicina <-as.factor(finalni_small.test$Velicina)
finalni_small.test$Sifra_opstine3 <-as.factor(finalni_small.test$Sifra_opstine3)
Dugo ocekivani trenutak:
model.null.small = glm(default.y ~ 1,
data=finalni_small,
family = binomial(link="logit")
)
model.full.small = glm(default.y ~ .,
data=finalni_small,
family = binomial(link="logit")
)
step(model.null.small,
scope = list(upper=model.full.small,lower=model.null.small),
direction="forward",
data=finalni_small,trace=0)
Call: glm(formula = default.y ~ T12 + Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja +
Asset_turnover + `Racio_novcane_likvidnosti_(Cash_ratio)` +
Sifra_opstine3 + udeo_u_kapitalu + Stepen_zaduzenosti + Vreme_kreditiranja_kupaca +
Sifra_sektor2 + `Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` +
Broj_zaposlenih + Racio_pokrica_obrtne_imovine + Velicina +
T14 + Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja,
family = binomial(link = "logit"), data = finalni_small)
Coefficients:
(Intercept)
-5.6165874
T12
-2.7772841
Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja
-0.0289081
Asset_turnover
-0.1854926
`Racio_novcane_likvidnosti_(Cash_ratio)`
-1.6625834
Sifra_opstine33%
0.3689998
Sifra_opstine34-5%
0.6810619
Sifra_opstine36%
0.9404356
Sifra_opstine37%
0.9770421
Sifra_opstine38>%
1.1036830
udeo_u_kapitalu
0.0269230
Stepen_zaduzenosti
0.0076335
Vreme_kreditiranja_kupaca
0.0003728
Sifra_sektor214%
-0.0169039
Sifra_sektor23%
-0.6711506
Sifra_sektor25%
-0.3120925
Sifra_sektor26-9%
-0.1988994
`Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)`
0.0009682
Broj_zaposlenih
-0.0021480
Racio_pokrica_obrtne_imovine
0.0114913
Velicina2
-0.1238959
T14
0.0104025
Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja
-0.0013645
Degrees of Freedom: 35913 Total (i.e. Null); 35891 Residual
Null Deviance: 14240
Residual Deviance: 12580 AIC: 12630
model1.small <-glm(formula = default.y ~ T12 + Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja +
Asset_turnover + `Racio_novcane_likvidnosti_(Cash_ratio)` +
Sifra_opstine3 + udeo_u_kapitalu + Stepen_zaduzenosti + Vreme_kreditiranja_kupaca +
Sifra_sektor2 + `Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` +
Broj_zaposlenih + Racio_pokrica_obrtne_imovine + Velicina +
T14 + Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja,
family = binomial(link = "logit"), data = finalni_small)
model1.small.data.frame<-data.frame(fit1=model1.small$fitted.values, dif1=model1.small$model$default.y)
step(model.full.small,
scope = list(lower=model.full.small,upper=model.null.small),
direction="backward",
data=finalni_small, trace=0)
Call: glm(formula = default.y ~ `Racio_novcane_likvidnosti_(Cash_ratio)` +
Broj_zaposlenih + Stepen_zaduzenosti + `Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` +
Racio_pokrica_obrtne_imovine + Gotovinski_ciklus_1 + Vreme_kreditiranja_kupaca +
Vreme_naplate_potrazivanja + Vreme_placanja_dobavljacima +
Asset_turnover + Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja +
Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja + T12 +
T14 + udeo_u_kapitalu + Velicina + Sifra_sektor2 + Sifra_opstine3,
family = binomial(link = "logit"), data = finalni_small)
Coefficients:
(Intercept)
-5.607e+00
`Racio_novcane_likvidnosti_(Cash_ratio)`
-1.659e+00
Broj_zaposlenih
-2.205e-03
Stepen_zaduzenosti
7.742e-03
`Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)`
9.621e-04
Racio_pokrica_obrtne_imovine
1.258e-02
Gotovinski_ciklus_1
-7.728e-05
Vreme_kreditiranja_kupaca
4.737e-04
Vreme_naplate_potrazivanja
-8.573e-05
Vreme_placanja_dobavljacima
-4.906e-06
Asset_turnover
-1.883e-01
Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja
-1.357e-03
Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja
-2.888e-02
T12
-2.769e+00
T14
1.052e-02
udeo_u_kapitalu
2.787e-02
Velicina2
-1.320e-01
Sifra_sektor214%
-7.684e-03
Sifra_sektor23%
-6.732e-01
Sifra_sektor25%
-3.097e-01
Sifra_sektor26-9%
-1.912e-01
Sifra_opstine33%
3.658e-01
Sifra_opstine34-5%
6.793e-01
Sifra_opstine36%
9.400e-01
Sifra_opstine37%
9.722e-01
Sifra_opstine38>%
1.099e+00
Degrees of Freedom: 35913 Total (i.e. Null); 35888 Residual
Null Deviance: 14240
Residual Deviance: 12580 AIC: 12630
model2.small= glm(formula = default.y ~ `Racio_novcane_likvidnosti_(Cash_ratio)` +
Broj_zaposlenih + Stepen_zaduzenosti + `Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` +
Racio_pokrica_obrtne_imovine + Gotovinski_ciklus_1 + Vreme_kreditiranja_kupaca +
Vreme_naplate_potrazivanja + Vreme_placanja_dobavljacima +
Asset_turnover + Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja +
Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja + T12 +
T14 + udeo_u_kapitalu + Velicina + Sifra_sektor2 + Sifra_opstine3,
family = binomial(link = "logit"), data = finalni_small)
model2.small.data.frame=data.frame(fit2=model2.small$fitted.values, dif2=model2.small$model$default.y)
Wald statistik:
library(car)
Anova(model1.small, type="II", test="Wald")
Analysis of Deviance Table (Type II tests)
Response: default.y
Df Chisq
T12 1 214.3368
Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja 1 44.5433
Asset_turnover 1 45.5246
`Racio_novcane_likvidnosti_(Cash_ratio)` 1 68.2248
Sifra_opstine3 5 52.3861
udeo_u_kapitalu 1 62.2519
Stepen_zaduzenosti 1 32.1689
Vreme_kreditiranja_kupaca 1 14.0409
Sifra_sektor2 4 22.4703
`Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` 1 12.6258
Broj_zaposlenih 1 4.8651
Racio_pokrica_obrtne_imovine 1 4.1235
Velicina 1 4.3035
T14 1 2.7113
Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja 1 2.5171
Pr(>Chisq)
T12 < 2.2e-16 ***
Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja 2.488e-11 ***
Asset_turnover 1.507e-11 ***
`Racio_novcane_likvidnosti_(Cash_ratio)` < 2.2e-16 ***
Sifra_opstine3 4.495e-10 ***
udeo_u_kapitalu 3.022e-15 ***
Stepen_zaduzenosti 1.413e-08 ***
Vreme_kreditiranja_kupaca 0.0001789 ***
Sifra_sektor2 0.0001615 ***
`Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` 0.0003805 ***
Broj_zaposlenih 0.0274049 *
Racio_pokrica_obrtne_imovine 0.0422917 *
Velicina 0.0380345 *
T14 0.0996418 .
Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja 0.1126168
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Langrange multiplier test:
anova(model1.small,
model.null.small,
test="Chisq")
Analysis of Deviance Table
Model 1: default.y ~ T12 + Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja +
Asset_turnover + `Racio_novcane_likvidnosti_(Cash_ratio)` +
Sifra_opstine3 + udeo_u_kapitalu + Stepen_zaduzenosti + Vreme_kreditiranja_kupaca +
Sifra_sektor2 + `Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` +
Broj_zaposlenih + Racio_pokrica_obrtne_imovine + Velicina +
T14 + Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja
Model 2: default.y ~ 1
Resid. Df Resid. Dev Df Deviance Pr(>Chi)
1 35891 12584
2 35913 14243 -22 -1659.5 < 2.2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Drugi nacin
auroc.1<-auc(
as.numeric(model1.small.data.frame$dif1),
as.numeric(model1.small.data.frame$fit1))
auroc.2<-auc(
as.numeric(model2.small.data.frame$dif2),
as.numeric(model2.small.data.frame$fit2))
c(auroc.1,auroc.2)
[1] 0.7728342 0.7726643
model1.small.pred<-as.numeric(predict(model1.small, newdata = finalni_small.test, type = "response"))
dif.small.valid<-small.test$default.y
model2.small.pred<-as.numeric(predict(model2.small, newdata = finalni_small.test, type = "response"))
auroc.1.pred<-auc(dif.small.valid, model1.small.pred)
auroc.2.pred<-auc(dif.small.valid, model2.small.pred)
c(auroc.1.pred,auroc.2.pred)
[1] 0.7467612 0.7469133
my.vars.small <-finalni_small# a matrix with your 14 different environmental variables
names(my.vars.small)[c(1, 4)] <-
c("Racio_novcane_likvidnosti",
"Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza")
my.vars.small.valid <- finalni_small.test#
names(my.vars.small.valid)[c(1, 4)] <-
c("Racio_novcane_likvidnosti",
"Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza")
my.vars.small$default.y=NULL
Adding new column 'default.y' then assigning NULL (deleting it).
library(speedglm)
nvar.small<-ncol(my.vars.small)
#colnames(my.vars) <- paste("var", 1:nvar, sep="") # add row names "var1" - "var14"
my.grad.data.small <- 1:nvar.small
sum.vars.small <- vector()
auc.p.small <- vector()
auc.pred.smal<-vector()
comb.mat.small <- matrix(numeric(0), nrow=nvar.small, ncol=0) # initialise the matrix containing all combinations
dif.small.valid<-small.test$default.y
for ( i in 1:nvar.small ) { # generate and store all possible combination of sums of the 14 variables
t.mat.small <- combn(my.grad.data.small, m=i)
comb.mat.small <- cbind(comb.mat.small, rbind(t.mat.small, matrix(NA, ncol=dim(t.mat.small)[2] , nrow=nvar.small-i)))
}
colnms.small<-colnames(my.vars.small)
my.vars.small$default.y=small.training$default.y
num.of.vars.small <- apply(as.data.frame(comb.mat.small),c(2)
, function(x) {
sum(as.numeric(!is.na(x)))
})
for ( j in 1:dim(comb.mat.small)[2] ) { # calculate and store the R2 for all combinations
#sum.vec <- rowSums(my.vars[, comb.mat[, j]], na.rm=TRUE)
sum.vars.small[j] <- paste( colnms.small[c(na.omit(comb.mat.small[, j]))],
collapse="+")
relacija.small=as.formula(paste("default.y ~ ",sum.vars.small[j],sep = ""))
model.small = speedglm(relacija.small,
data = my.vars.small,
y=TRUE,
fitted = TRUE,
family = binomial(link = "logit"))
model.small.data.frame=data.frame(fit=fitted.values(model.small), dif=model.small$y)
#browser()
auc.p.small[j] <- auc_roc(as.numeric(model.small.data.frame$fit),as.numeric(model.small.data.frame$dif))
#auc.p.small[j] <-fastAUC(as.numeric(model.small.data.frame$fit),as.numeric(model.small.data.frame$dif))
model.small.pred<-as.numeric(predict(model.small, newdata = my.vars.small.valid, type = "response"))
auc.pred.smal[j]<-auc_roc( model.small.pred,dif.small.valid)
#auc.pred.smal[j]<-fastAUC( model.small.pred,dif.small.valid)
if(j %in% round(seq(from=1, to=dim(comb.mat.small)[2],length.out = 100))) print(j/dim(comb.mat.small)[2])
#print(j)
#if(j==8) browser()
}
[1] 3.814712e-06
[1] 0.01010517
[1] 0.02020653
[1] 0.03030789
[1] 0.04040924
[1] 0.05050678
[1] 0.06060814
[1] 0.0707095
[1] 0.08081086
[1] 0.09091221
[1] 0.1010136
[1] 0.1111149
[1] 0.1212163
[1] 0.1313176
[1] 0.141419
[1] 0.1515165
[1] 0.1616179
[1] 0.1717193
[1] 0.1818206
[1] 0.191922
[1] 0.2020233
[1] 0.2121247
[1] 0.222226
[1] 0.2323274
[1] 0.2424288
[1] 0.2525263
[1] 0.2626276
[1] 0.272729
[1] 0.2828304
[1] 0.2929317
[1] 0.3030331
[1] 0.3131344
[1] 0.3232358
[1] 0.3333371
[1] 0.3434385
[1] 0.353536
[1] 0.3636374
[1] 0.3737388
[1] 0.3838401
[1] 0.3939415
[1] 0.4040428
[1] 0.4141442
[1] 0.4242455
[1] 0.4343469
[1] 0.4444483
[1] 0.4545458
[1] 0.4646472
[1] 0.4747485
[1] 0.4848499
[1] 0.4949512
[1] 0.5050526
[1] 0.5151539
[1] 0.5252553
[1] 0.5353567
[1] 0.545458
[1] 0.5555556
[1] 0.5656569
[1] 0.5757583
[1] 0.5858596
[1] 0.595961
[1] 0.6060623
[1] 0.6161637
[1] 0.6262651
[1] 0.6363664
[1] 0.6464678
[1] 0.6565653
[1] 0.6666667
[1] 0.676768
[1] 0.6868694
[1] 0.6969707
[1] 0.7070721
[1] 0.7171735
[1] 0.7272748
[1] 0.7373762
[1] 0.7474775
[1] 0.7575751
[1] 0.7676764
[1] 0.7777778
[1] 0.7878791
[1] 0.7979805
[1] 0.8080818
[1] 0.8181832
[1] 0.8282846
[1] 0.8383859
[1] 0.8484873
[1] 0.8585848
[1] 0.8686862
[1] 0.8787875
[1] 0.8888889
[1] 0.8989902
[1] 0.9090916
[1] 0.919193
[1] 0.9292943
[1] 0.9393957
[1] 0.949497
[1] 0.9595946
[1] 0.9696959
[1] 0.9797973
[1] 0.9898986
[1] 1
result.frame.small <- data.frame(combination=sum.vars.small, auc.p.small=auc.p.small, auc.valid.small=auc.pred.smal,num_of_vars=num.of.vars.small)
result.frame.small.sorted <- result.frame.small[order(auc.pred.smal, decreasing=TRUE), ]
head(result.frame.small.sorted, n=100) # the 10 "best" combinations
Vidi Rating Models and Validation - Oesterreichische Nationalbank (OeNB).↩
Hayden, E., & Porath, D. (2011). Statistical Methods to Develop Rating Models. In B. Engelmann, and R. Rauhmeier (Eds.), The Basel II Risk Parameters: Estimation, Validation, Stress Testing – with Applications to Loan Risk Management (pp. 1–12). New York: Springer.↩